home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-12-19 | 4.6 KB | 140 lines | [TEXT/ttxt] |
- <<<
- append theContainerSearchList (parentDir (parentDir theScriptDir))
- global dtkLib := open LibraryContainer dir:(parentDir theScriptDir) path:"DTKSaver.sxl"
- global ccLib := open LibraryContainer dir:(parentDir theScriptDir) path:"CustClass.sxl"
-
- module Builder
- uses ScriptX
- uses DTKSaver
- uses CustomClassesInterface
- exports BuildATitle
- end
-
- fileIn theScriptDir name:"globals.lib" module:@Builder
-
- in module Builder
-
- function getClassByName cName ->
- (
- chooseOne (allInstances RootClass) (obj name-> return ((obj as String) = name)) cName
- )
-
- function labelFromFrame theFrame dirInfo->
- (
- local lblList := dirInfo[@markers]
- local newName := undefined
- for lblNum := 1 to lblList.size do (
- if lblList[lblNum].start = theFrame do (
- newName := lblList[lblNum].label
- exit
- )
- )
- if newName = undefined do (
- newName := new String
- format newName "Frame_%*" theFrame @unadorned
- )
- return newName
- )
-
- function BuildATitle director->
- (
- format debug "\n***************\n* BuildATitle *\n***************\n" undefined undefined
- local w := new stage boundary:(director[@stageRect]) centered:true
- local cast := director[@cast]
- for frame in director[@score] do (
- local spriteChannels := frame[@spriteChannels]
- local newClass := undefined
- local frameScript := spriteChannels[1][@lingoscript]
- if frameScript <> undefined do (
- local script := frameScript
- local newClassName := findSXKey(script, "Class")
- if newClassName = "Scene" do (
- print "--------- SCENE -------------" --debug
- local newScene := new Scene lingo:script boundary:(w.bbox)
- newScene.fill := new Brush color:(director[@backColor])
- local sceneName := labelFromFrame(frame[@absoluteFrameNumber], director)
- newScene.name := sceneName
- local sceneHelp := getKeyOne director[@castNames] ((sceneName + "help") as string)
- if sceneHelp = empty then
- setHelp newScene undefined
- else
- setHelp newScene cast[sceneHelp]
- addScene w newScene sceneName
- format debug "Name: %*\n" sceneName @unadorned
- local sndCast
- for snd in frame[@soundChannels] do (
- if snd <> 0 do (
- newScene.sceneAudio := cast[snd]
- format debug "Sound found for scene %1: %2(%3)\n" #(sceneName,(newScene.sceneAudio as string),snd) #(@unadorned,@unadorned)
- )
- )
- local castIndex
- local spriteInfo
- for s := 2 to 24 do (
- spriteInfo := spriteChannels[s]
- castIndex := spriteInfo[@castIndex]
- if castIndex > 0 do (
- local lingoScript := spriteInfo[@lingoScript]
- local customClass := findSXKey( lingoScript, "Class")
- local myCast := cast[castIndex]
- local newObj
- if customClass = undefined then (
- if findSXKey( lingoScript, "Ignore") = undefined then(
- if isAKindOf myCast TextPresenter then (
- newObj := myCast
- ) else (
- newObj := (new TwoDShape boundary:myCast.boundary)
- )
- newObj.stationary := true
- ) else(
- newObj := undefined
- )
- ) else (
- local custClass := custClassList[customClass as stringConstant]
- if custClass = empty then (
- format debug "-- ** ERROR: custom class not found (%*)\n" customClass @unadorned
- ) else (
- format debug "Instantiating a custom %*...\n" (customClass) @unadorned
- newObj := new custClass castNum:castIndex lingo:lingoScript dirInfo:(director) score:(director[@score]) currScene:(newScene)
- )
- )
- if newObj = undefined then (
- format debug "Element skipped..." undefined undefined
- ) else (
- newObj.x := spriteInfo[@x]
- newObj.y := spriteInfo[@y]
- local bndry := newObj.boundary
- if isAKindOf bndry Bitmap do (
- case spriteInfo[@ink] of
- @invisible: bndry.invisibleColor := whiteColor
- @matte: bndry.matteColor := whiteColor
- end
- )
- if customClass = "Animation" then (
- newObj.authorData := w
- append newScene.players newObj
- ) else (
- prepend newScene newObj
- )
- format debug "Element: %1\tink: %2\n" #((getClassName newObj), spriteInfo[@ink]) #(@unadorned,@unadorned)
- )
- )
- )
- )
- )
- )
- print "--------- END -------------" --debug
- return w
- )
- in module scratch
- (
- local lc := new libraryContainer path:"builder.sxl" dir:(parentdir thescriptdir)
- addUser dtkLib lc
- addUser ccLib lc
- append lc (getModule @builder)
- lc.startupAction := (lc->load lc[1])
- close lc
- )
- -->>>
- quit()
-